perm filename MOVJ.F4[NEW,LCS] blob
sn#148541 filedate 1975-03-04 generic text, type T, neo UTF8
00100 SUBROUTINE MOVJ(ROV,RZRO,RRT,RSTFAC,RN,PWDS,ITEM,I,ML,M)
00110 C M=4 NORMALLY -- BUT MORE IN 'JUST'
00200 DIMENSION RN(1),PWDS(1),R(2,200),IR(2,200),RSTFAC(1)
00300 EQUIVALENCE (IR,R)
00400 DATA RI/4.5/,RSP/.5/
00500
00510 IF(ML.EQ.1)GO TO 16
00600 IF(ML)GO TO 19
00800 RJSZ=RI
02705 RCNT=0
02710 ML=1
02720 ROV=RRT
02730 PRCNT=1.
02800 ASK=-1
03200 19 IF(RCNT.GT.9)GO TO 101
03400 RJSZ=RJSZ-.1
03410 RP=PRCNT
03500 RCNT=RCNT+1
03600 C TEMPORARY COUNTER
03800 CALL TYPX(RCNT)
03900
03950 KN=-3
04000 CC DO 11 KN=-3,4
04050 C HERE BEGINS THE BIG LOOP
04100 111 RSPC=0
04200 R8=KN
04300 N=0
04310
04400 DO 2 K=1,ITEM
04500 L=PWDS(K)
04600 IF(RTLINE(L))GO TO 2
04700 RA=RN(L+1)
04800 RB=RN(L+3)
04850 IF(RB.LT.RZRO)GO TO 2
04900 IF(RN(L+2).EQ.R8)GO TO 77
05000 IF(RA.NE.4)GO TO 2
05200 C SKIPS HOMED NOTES (IN CHORDS)
05300 77 IF(RA.EQ.1)GO TO 10
05400 27 IF(RA.LE.4)GO TO 177
05425 IF(RA.LT.17)GO TO 2
05450 C LOOKS AT NOTES,RESTS,CLEFS,BAR LINES,KSIGS,METERS.
05500 177 IF(RA.NE.4)GO TO 10
05550 IF(RN(L).GT.2)GO TO 2
05600 C SHOULD CHECK ON BAR LINES NO MATTER WHICH STAFF
05700 10 N=N+1
05800 R(1,N)=RB
05900 IR(2,N)=L
06000 IF(N.EQ.200)GO TO 28
06100 C ONLY TREATS 200 ITEMS AT A TIME.
06200 2 CONTINUE
06210
06300 IF(N.EQ.0)GO TO 11
06400 28 DO 23 K=1,N
06500 23 IF(RN(IR(2,K)+1).NE.4)GO TO 24
06600 C SKIPS IF ONLY BAR LINES ON THIS STAFF
06700 GO TO 11
06750 101 ML=5
06775 RETURN
06800 24 RSTJ2=RSTFAC(KN)*PRCNT
07000 CALL SORT2(R,N)
07100
07200 C JUMP IF LAST IS A BAR LINE.
07300 K=0
07310 JLDGR=0
07400 JX=0
07500 22 K=K+1
07600 122 L=IR(2,K)
07700 RA=RN(L+1)
07800 RB=0
07900 RX=RN(L+5)
07950 C RX=PARAM 5
07975 RX6=RN(L+6)
08000 RY=1
08100 RW=AMOD(RN(L+4),100.)
08200 IF(RA.GT.1)GO TO 4
08300 RZ=RN(L+7)
08325 IF(LDGR.NE.JLDGR)JLDGR=0
08350 LDGR=0
08400 JY=K
08500 DO 32 JJ=JY+1,N+1
08550 K=JJ
08600 32 IF(R(1,JJ)-R(1,JJ-1).GT.RSP)GO TO 35
09000 C FOUND HOW MANY MEMBERS TO CHORD.
09400 35 RB=0
09450 K=K-1
09500 RQ=0
09600 RD=0
09700 125 IF(AMOD(RN(L+4),200.).GT.60.)RY=.6
09800 DO 37 JJ=JY,K-1
09850 IF(RD.NE.0)GO TO 38
09875 C FINDS ONLY HIGH OR! LOW LED. LINE.
09887 JR=IR(2,JJ)
09900 RW=AMOD(RN(JR+4),100.)
10000 IF(RW.GT.11)GO TO 277
10025 IF(RW.GE.2)GO TO 38
10050 277 LDGR=-1
10100 IF(RW.GT.11)LDGR=1
10150 IF(JLDGR.EQ.LDGR)GO TO 36
10187 JLDGR=LDGR
10200 C LDGR IS FOR LEDGER LINES.
10225 GO TO 38
10260 36 RD=1.5
10270 RQ=RD
10300 38 IF(RB.GT.2)GO TO 222
10400 C JUMP IF LARGE SPACE AFTER NOTE IS ALREADY SET UP.
10500 RZZ=RN(JR+7)
10600 RE=RN(JR+5)
10700 CC IF(RB.LT.2.AND.((AMOD(RZZ,10.).NE.0.AND.RE.LT.20).
10800 CC 1 OR.RZZ.GE.10))RB=1.5+EXTEN(RZZ)
10805 IF(RB.GE.2)GO TO 477
10810 IF(RZZ.GE.10)GO TO 377
10820 IF(RE.GE.20)GO TO 477
10830 IF(AMOD(RZZ,10.).EQ.0)GO TO 477
10890 377 RB=1.5+EXTEN(RZZ)
10900 C SPACE FOR DOT OR TAIL(IF STEM UP)
11000 477 IF(ABS(RN(JR+6)).EQ.10)RB=RB+2
11100 C FOR CHORD TONES ON RIGHT OF STEM UP.
11200 C LOOKS THROUGH ALL NOTES OF A CHORD.
11300 222 IF(AMOD(RE,10.).EQ.0)GO TO 37
11400 C JUMP IF NO ACCIS.
11500 425 RD=2*RY+EXTEN(RE)
11600 IF(RQ.GT.RD)RD=RQ
11700 RQ=RD
11800 C FUNCT. EXTEN=AMOD(X,1.)*10.
11900 37 CONTINUE
12000 IF(RY.NE.1)RB=RB-.5*RJSZ
12100 C MINI NOTES NEED LESS SPACE
12600 25 IF(JX.GT.0)R(2,JX)=R(2,JX)+RD*RSTJ2
12700 GO TO 17
12800 4 IF(RA.NE.3)GO TO 29
12900 RB=3
13000 IF(RX.GT.100)RB=1.5
13100 C CHECK ON SIZE NEEDED FOR CLEFS
13200 29 IF(RA.NE.4)GO TO 26
13300 RB=-RJSZ/2
13400 RD=.9
13500 GO TO 25
13600 26 IF(RA.NE.18)GO TO 30
13700 IF(RX6.GT.9)GO TO 31
13705 IF(RX.GT.9)GO TO 31
13710 C CHECKS FOR 2-DIGIT METERS
13800 RB=-1
13900 RD=1
14000 GO TO 25
14100 31 RB=2
14200 RD=3
14300 GO TO 25
14400 30 IF(RA.NE.17)GO TO 17
14455 RB=2*(ABS(RX)-1)-2
14460 C SPACES FOR CORRECT NUM OF ACCIS. RX=NUM OF ACCIS.
14475 RD=2
14487 GO TO 25
14700 17 RC=(RB+RJSZ)*RSTJ2
14800 C RJSZ=DEFAULT SIZE
14900 JX=JX+1
15000 R(2,JX)=RC
15100 R(1,JX)=R(1,K)
15200 3 IF(K.LT.N)GO TO 22
15300 RA=R(1,1)
15400 RB=R(2,1)
15500
15600 DO 13 KX=2,JX
15700 RE=R(1,KX)
15800 C POS. BEFORE SHIFTING
15900 IF(ABS(RE-RA).GT..5)GO TO 14
16000 IF(R(2,KX).GT.RB)GO TO 16
16100 C SKIPS DOUBLE STOPS AND VERY CLOSE ITEMS
16200 GO TO 13
16400 C JUMP WHEN SPACE TO ADD IS SMALLER THAN WHAT'S ALREADY THERE
16600 14 RD=RA+RB-RE
16700 IF(RD.LE.0)GO TO 16
16800 C THERE'S ENOUGH ROOM
17000 R4=RE+RSPC-.001
17100 R5=1000
17200 R8=RD
17300 R9=0
17400 RSPC=RSPC+RD
17500 C RSPC SAVES TOTAL SPACE ADDED
17600 C GO EXPAND IT
17700 IF(R(2,KX).NE.0)RETURN
17800 16 RB=R(2,KX)
17900 13 RA=RE
18000 CC11 CONTINUE
18010 11 KN=KN+1
18020 IF(KN.LE.M)GO TO 111
18030 C M=4 NORMALLY -- BUT FOR 'JUST' IT IS BIGGER.
18040
18100 110 IF(ROV.LE.RRT+.01)GO TO 18
18110 IF(RJSZ.GT.4)RJSZ=4
18120 PRCNT=(ROV-RZRO)/(RRT-RZRO)
18160 CC RP=RJSZ/(RJSZ-.1)
18180 IF(PRCNT.NE.RP)GO TO 19
18190 C GO BACK AND EXPAND SOME MORE
18240 66 ML=2
18265 RETURN
18290 18 ML=3
18590 END